home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 4 / Gold Medal Software - Volume 4 (Gold Medal) (1994).iso / utils1 / fsp112.arj / FSP.PAS < prev    next >
Pascal/Delphi Source File  |  1994-08-09  |  7KB  |  217 lines
  1. PROGRAM FSP;
  2. {------------------------------------------------------------------------------
  3.  
  4.                                 REVISION HISTORY
  5.  
  6. v1.00  : 1993/07/14.  First public release.  DDA
  7. v1.01  : 1993/12/26.  Now discards data from FIRST CD-ROM drive.  DDA
  8. v1.02  : 1994/01/20.  Now only reports valid local (inc. RAM) drives,
  9.                       C through Z.  Remote, SUBST, and CD drives ignored.  DDA
  10. v1.10  : 1994/01/23.  Added volume label info.  Edward Dombek (73727,162)
  11. v1.11  : 1994/01/24.  Integrated various previous suggestions above.  DDA
  12. v1.12  : 1994/08/09.  Changed Total amounts from LongInt to Real.  Now can
  13.                       handle multi-gig drives accurately, provided no single
  14.                       partition exceeds 2 gig (LongInt).  Neil Edward Parks
  15.                       Overall design improvements. DDA
  16.  
  17. ------------------------------------------------------------------------------}
  18.  
  19. USES Crt, Dos;                       {Crt for colors, Dos for DiskSize/Free.}
  20. CONST
  21.   ProgDesc = 'FSP (Free SPace), v1.12 - DOS Multiple Hard Disk Space Utilization Utility.';
  22.   author   = 'FREE software!  Copyright : 94/08/09 by David Daniel Anderson - Reign Ware.';
  23.   ProgHead = 'DRIVE        ALLOCATED     FREE SPACE    TOTAL SPACE   FREE %   LABEL';
  24.   chart_width = 75;
  25. VAR
  26.   TS,TF,TU : Real;     {bytes of Total space Size/Free/Used}
  27.  
  28. FUNCTION Comma (r :Real) : STRING; {Used in WriteDriveInfo & WriteTotalInfo}
  29. VAR s : STRING[14];                {Insert commas to break up number string.}
  30.     l : ShortInt;
  31. BEGIN
  32.   Str (r :0 :0, s);
  33.   l:=(Length (s)-2);
  34.   WHILE (l > 1) DO BEGIN 
  35.     Insert (',', s, l);
  36.     Dec (l, 3);
  37.   END;
  38.   Comma:=s;
  39. END;
  40.  
  41. FUNCTION LeadingZero (w :Word) : STRING;  {Called by WriteDTInf to write time.}
  42. VAR  s : STRING;
  43. BEGIN
  44.   Str (w :0, s);
  45.   IF (Length (s) = 1) THEN
  46.     s:='0'+s;
  47.   LeadingZero:=s;
  48. END;
  49.  
  50. PROCEDURE WriteDTInf;            {Called by WriteHeader to write Date & Time.}
  51. CONST
  52.   Mon : ARRAY [1..12] OF STRING[9] =
  53.      ('January','February','March','April','May','June','July',
  54.       'August','September','October','November','December');
  55.   comma=#44;
  56.   space=#32;
  57.   colon=#58;
  58. VAR
  59.   Year, Month, Day, dow,
  60.   Hour, Min,   Sec, hund : Word;
  61.   DStr                   : STRING[8];
  62.   YStr                   : STRING[4];
  63.   DateStr                : STRING[chart_width-8];
  64.   offset                 : byte;
  65. BEGIN
  66.   GetDate (Year, Month, Day, dow);
  67.   GetTime (Hour, Min, Sec, hund);
  68.   Str (Day, DStr);
  69.   Str (Year, YStr);
  70.   DateStr:=Mon[Month]+space+DStr+comma+space+YStr;
  71.   offset:=length (DateStr);
  72.   DateStr[0]:=chr (chart_width-8);
  73.   FillChar (DateStr[offset+1], (chart_width-(offset+8)), space);
  74.   WriteLn (DateStr, 
  75.     LeadingZero (Hour)+colon, 
  76.     LeadingZero (Min)+colon, 
  77.     LeadingZero (Sec));
  78. END;
  79.  
  80. PROCEDURE WriteHeader;                 {Called by main.}
  81. VAR
  82.   hyphens : STRING[chart_width];
  83. BEGIN
  84.   hyphens[0]:=chr (chart_width);
  85.   FillChar (hyphens[1], chart_width, '-');
  86.   TextBackGround (Blue);  TextColor (White);
  87.   WriteLn (ProgDesc);                  {...a constant...}
  88.   WriteLn (author);                    {...a constant...}
  89.   TextBackGround (Black); TextColor (LightBlue);
  90.   WriteDTInf;
  91.   TextColor (LightCyan);
  92.   WriteLn (ProgHead);                  {...a constant...}
  93.   WriteLn (hyphens);
  94. END;
  95.  
  96. PROCEDURE WritePercent (Free, Space :Real);       { Called by WriteDriveInfo  }
  97.                                                  {         & WriteTotalInfo. }
  98. VAR PF  : Real;          {integer of Percentage Free, initially 10 x %}
  99. BEGIN
  100.   IF (Space > 0) THEN
  101.     PF:=100*(Free/Space)               {Using 100 to give hundredths of %}
  102.   ELSE
  103.     PF:=0;
  104.   TextColor (White);
  105.   Write (PF :8 :2, '%');
  106. END;
  107.  
  108. PROCEDURE WriteInColor (u, f, s :Real);
  109. BEGIN
  110.   TextColor (LightRed);      Write (Comma (U) :15);
  111.   TextColor (LightGreen);    Write (Comma (F) :15);
  112.   TextColor (LightMagenta);  Write (Comma (S) :15);
  113. END;
  114.  
  115. PROCEDURE WriteDriveInfo (DriveCounter :char);    {Called by main.}
  116. VAR DS,DF,DU : LongInt;   {bytes of *partition* space Size/Free/Used}
  117.     vLabel   : SearchRec;
  118.     VolName  : STRING[12];
  119. BEGIN
  120.   DS:=DiskSize (ord (DriveCounter)-64);
  121.   IF (DS < 0) THEN BEGIN
  122.     DS:=0;
  123.     DF:=0;
  124.   END
  125.   ELSE
  126.     DF:=DiskFree (ord (DriveCounter)-64);
  127.  
  128.   DU:=DS-DF;
  129.   TS:=TS+DS;    TF:=TF+DF;    TU:=TU+DU;
  130.  
  131.   TextColor (Yellow);        Write (DriveCounter, ' -->  ');
  132.   WriteInColor (DU, DF, DS);
  133.   WritePercent (DF, DS);               {...a procedure...}
  134.   FindFirst (DriveCounter+':\*.*', $8, vLabel);
  135.   {...Volume Label...}
  136.  
  137.   IF (DosError <> 0) THEN
  138.     VolName:='none'
  139.   ELSE BEGIN
  140.     VolName:=vLabel.Name;
  141.     IF (pos ('.', VolName) <> 0) THEN
  142.       delete (VolName, pos ('.', VolName), 1);
  143.     { remove period if present }
  144.   END;
  145.   TextColor (Yellow);        WriteLn ('   ', VolName);
  146. END;
  147.  
  148. PROCEDURE WriteTotalInfo;                          {Called by main.}
  149. VAR
  150.   EQLine : STRING[chart_width];
  151. BEGIN
  152.   EQLine[0]:=chr (chart_width);
  153.   FillChar (EQLine[1], chart_width, '=');
  154.   TextColor (LightGray);
  155.   WriteLn (EQline);
  156.  
  157.   TextColor (Yellow);        Write ('TOTALS=');
  158.   WriteInColor (TU, TF, TS);
  159.   WritePercent (TF, TS);               {...a procedure...}
  160.   WriteLn;
  161. END;
  162.  
  163. {=============================================================================}
  164.  
  165. FUNCTION IsDriveValid (cDrive :Char; VAR bLocal, bSUBST :Boolean): Boolean;
  166. { ** portion of a SWAG snippet
  167.  
  168.   Parameters: cDrive is the drive letter, 'A' to 'Z', that's about
  169.   to be checked. if not in this range, the Function will return False.
  170.  
  171.   Returns: Function returns True if the given drive is valid, else
  172.   False (!). bLocal is set if drive is local, bSUBST if drive is
  173.   substituted. if Function returns False, the Booleans are undefined.
  174. }
  175. VAR
  176.   rCPU: Dos.Registers;
  177. BEGIN
  178.   { --- Valid letter, set up For the Dos-call --- }
  179.   rCPU.bx:=ord (UpCase (cDrive))-ord ('A')+1;
  180.   rCPU.ax:=$4409;
  181.   { --- Call the Dos IOCTL (InOutConTroL)-Functions --- }
  182.   Intr ($21, rCPU);
  183.   IF ((rCPU.ax AND FCarry) = FCarry) THEN
  184.     IsDriveValid:=False
  185.   ELSE BEGIN
  186.     { --- drive is valid, check status --- }
  187.     IsDriveValid:=True;
  188.     bLocal:=((rCPU.dx AND $1000) = $0000);
  189.     IF (bLocal) THEN
  190.       bSUBST:=((rCPU.dx AND $8000) = $8000)
  191.     ELSE
  192.       bSUBST:=False;
  193.   END;
  194. END; { IsDriveValid }
  195. {=============================================================================}
  196.  
  197. VAR
  198.   cCurChar : Char ;          { loop counter, drive }
  199.   bLocal,
  200.   bSUBST   : Boolean ;       { drive local/remote?; SUBSTed or not? }
  201.  
  202. BEGIN
  203.   TS:=0;  TF:=0;  TU:=0;
  204.   IF (STRING (ptr (prefixseg, $0080)^) = '') THEN ClrScr;
  205.   {Clear screen unless ANY parameter given.}
  206.  
  207.   WriteHeader;                         {...a procedure...}
  208.  
  209.   FOR cCurChar:=#67 TO #90 DO          { from drive 'C' to drive 'Z' }
  210.     IF (IsDriveValid (cCurChar, bLocal, bSUBST)) THEN
  211.       IF (blocal AND (NOT bSUBST)) THEN
  212.         WriteDriveInfo (cCurChar);
  213.  
  214.   WriteTotalInfo;                      {...a procedure...}
  215.   NormVideo;
  216. END.
  217.